home *** CD-ROM | disk | FTP | other *** search
/ C++ für Kids / C++ for kids.iso / SETUP / CBUILDER / DATA.Z / SYSTEM.INT < prev    next >
Encoding:
Text File  |  1997-02-20  |  17.6 KB  |  567 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Runtime Library                          }
  4. {       System Unit                                     }
  5. {                                                       }
  6. {       Copyright (C) 1988-1997 Borland International   }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit System;        // $Revision:   1.29  $
  11.  
  12. {$H+,I-,S-}
  13.  
  14. interface
  15.  
  16. const
  17.  
  18. { Variant type codes }
  19.  
  20.   varEmpty    = $0000;
  21.   varNull     = $0001;
  22.   varSmallint = $0002;
  23.   varInteger  = $0003;
  24.   varSingle   = $0004;
  25.   varDouble   = $0005;
  26.   varCurrency = $0006;
  27.   varDate     = $0007;
  28.   varOleStr   = $0008;
  29.   varDispatch = $0009;
  30.   varError    = $000A;
  31.   varBoolean  = $000B;
  32.   varVariant  = $000C;
  33.   varUnknown  = $000D;
  34.   varByte     = $0011;
  35.   varString   = $0100;
  36.   varTypeMask = $0FFF;
  37.   varArray    = $2000;
  38.   varByRef    = $4000;
  39.  
  40. { TVarRec.VType values }
  41.  
  42.   vtInteger    = 0;
  43.   vtBoolean    = 1;
  44.   vtChar       = 2;
  45.   vtExtended   = 3;
  46.   vtString     = 4;
  47.   vtPointer    = 5;
  48.   vtPChar      = 6;
  49.   vtObject     = 7;
  50.   vtClass      = 8;
  51.   vtWideChar   = 9;
  52.   vtPWideChar  = 10;
  53.   vtAnsiString = 11;
  54.   vtCurrency   = 12;
  55.   vtVariant    = 13;
  56.  
  57. type
  58.  
  59.   TObject = class;
  60.  
  61.   TClass = class of TObject;
  62.  
  63.   TObject = class
  64.     constructor Create;
  65.     procedure Free;
  66.     class function InitInstance(Instance: Pointer): TObject;
  67.     procedure CleanupInstance;
  68.     function ClassType: TClass;
  69.     class function ClassName: ShortString;
  70.     class function ClassNameIs(const Name: string): Boolean;
  71.     class function ClassParent: TClass;
  72.     class function ClassInfo: Pointer;
  73.     class function InstanceSize: Longint;
  74.     class function InheritsFrom(AClass: TClass): Boolean;
  75.     class function MethodAddress(const Name: ShortString): Pointer;
  76.     class function MethodName(Address: Pointer): ShortString;
  77.     function FieldAddress(const Name: ShortString): Pointer;
  78.     procedure AfterConstruction; virtual;
  79.     procedure BeforeDestruction; virtual;
  80.     procedure Dispatch(var Message); virtual;
  81.     procedure DefaultHandler(var Message); virtual;
  82.     class function NewInstance: TObject; virtual;
  83.     procedure FreeInstance; virtual;
  84.     destructor Destroy; virtual;
  85.   end;
  86.  
  87.   TVarArrayBound = record
  88.     ElementCount: Integer;
  89.     LowBound: Integer;
  90.   end;
  91.  
  92.   PVarArray = ^TVarArray;
  93.   TVarArray = record
  94.     DimCount: Word;
  95.     Flags: Word;
  96.     ElementSize: Integer;
  97.     LockCount: Integer;
  98.     Data: Pointer;
  99.     Bounds: array[0..255] of TVarArrayBound;
  100.   end;
  101.  
  102.   PVarData = ^TVarData;
  103.   TVarData = record
  104.     VType: Word;
  105.     Reserved1, Reserved2, Reserved3: Word;
  106.     case Integer of
  107.       varSmallint: (VSmallint: Smallint);
  108.       varInteger:  (VInteger: Integer);
  109.       varSingle:   (VSingle: Single);
  110.       varDouble:   (VDouble: Double);
  111.       varCurrency: (VCurrency: Currency);
  112.       varDate:     (VDate: Double);
  113.       varOleStr:   (VOleStr: PWideChar);
  114.       varDispatch: (VDispatch: Pointer);
  115.       varError:    (VError: Integer);
  116.       varBoolean:  (VBoolean: WordBool);
  117.       varUnknown:  (VUnknown: Pointer);
  118.       varByte:     (VByte: Byte);
  119.       varString:   (VString: Pointer);
  120.       varArray:    (VArray: PVarArray);
  121.       varByRef:    (VPointer: Pointer);
  122.   end;
  123.  
  124.   PShortString = ^ShortString;
  125.   PAnsiString = ^AnsiString;
  126.   PString = PAnsiString;
  127.  
  128.   PExtended = ^Extended;
  129.   PCurrency = ^Currency;
  130.   PVariant = ^Variant;
  131.  
  132.   TDateTime = type Double;
  133.  
  134.   PVarRec = ^TVarRec;
  135.   TVarRec = record
  136.     case Byte of
  137.       vtInteger:    (VInteger: Integer; VType: Byte);
  138.       vtBoolean:    (VBoolean: Boolean);
  139.       vtChar:       (VChar: Char);
  140.       vtExtended:   (VExtended: PExtended);
  141.       vtString:     (VString: PShortString);
  142.       vtPointer:    (VPointer: Pointer);
  143.       vtPChar:      (VPChar: PChar);
  144.       vtObject:     (VObject: TObject);
  145.       vtClass:      (VClass: TClass);
  146.       vtWideChar:   (VWideChar: WideChar);
  147.       vtPWideChar:  (VPWideChar: PWideChar);
  148.       vtAnsiString: (VAnsiString: Pointer);
  149.       vtCurrency:   (VCurrency: PCurrency);
  150.       vtVariant:    (VVariant: PVariant);
  151.   end;
  152.  
  153.   PMemoryManager = ^TMemoryManager;
  154.   TMemoryManager = record
  155.     GetMem: function(Size: Integer): Pointer;
  156.     FreeMem: function(P: Pointer): Integer;
  157.     ReallocMem: function(P: Pointer; Size: Integer): Pointer;
  158.   end;
  159.  
  160.   THeapStatus = record
  161.     TotalAddrSpace: Cardinal;
  162.     TotalUncommitted: Cardinal;
  163.     TotalCommitted: Cardinal;
  164.     TotalAllocated: Cardinal;
  165.     TotalFree: Cardinal;
  166.     FreeSmall: Cardinal;
  167.     FreeBig: Cardinal;
  168.     Unused: Cardinal;
  169.     Overhead: Cardinal;
  170.     HeapErrorCode: Cardinal;
  171.   end;
  172.  
  173. threadvar
  174.  
  175.   RaiseList: Pointer;     { Stack of current exception objects }
  176.   InOutRes: Integer;      { Result of I/O operations }
  177.  
  178. var
  179.  
  180.   ExceptProc: Pointer;    { Unhandled exception handler }
  181.   ErrorProc: Pointer;     { Error handler procedure }
  182.   ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
  183.   ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
  184.   ExceptionClass: TClass; { Exception base class (must be Exception) }
  185.   HPrevInst: Longint;     { Handle of previous instance }
  186.   HInstance: Longint;     { Handle of this instance }
  187.   CmdShow: Integer;       { CmdShow parameter for CreateWindow }
  188.   CmdLine: PChar;         { Command line pointer }
  189.         InitProc: Pointer;                      { Last installed initialization procedure }
  190.   ExitCode: Integer;      { Program result }
  191.   ExitProc: Pointer;      { Last installed exit procedure }
  192.   ErrorAddr: Pointer;     { Address of run-time error }
  193.   DllProc: Pointer;       { Called whenever DLL entry point is called }
  194.   RandSeed: Longint;      { Base for random number generator }
  195.   IsLibrary: Boolean;     { True if module is a DLL }
  196.   IsConsole: Boolean;     { True if compiled as console app }
  197.   IsMultiThread: Boolean; { True if more than one thread }
  198.   FileMode: Byte;         { Standard mode for opening files }
  199.   Test8086: Byte;         { Will always be 2 (386 or later) }
  200.   Test8087: Byte;         { Will always be 3 (387 or later) }
  201.   TestFDIV: Shortint;     { -1: Flawed Pentium, 0: Not determined, 1: Ok }
  202.   Input: Text;            { Standard input }
  203.   Output: Text;           { Standard output }
  204.   TlsIndex: Integer;      { Thread local storage index }
  205.   TlsIndex4: Integer;     { Thread local storage index*4 }
  206.   TlsLast: Byte;          { Set by linker so its offset is last in TLS segment }
  207.  
  208. const
  209.   HeapAllocFlags: Word = 2;   { Heap allocation flags, gmem_Moveable }
  210.   DebugHook: Byte = 0;     {  1 to notify debugger of non-Delphi exceptions
  211.                              >1 to notify debugger of exception unwinding }
  212. exports
  213.   DebugHook      name '_DebugHook',
  214.   ExceptionClass name '_ExceptionClass';
  215.  
  216. var
  217.   Unassigned: Variant;    { Unassigned standard constant }
  218.   Null: Variant;          { Null standard constant }
  219.  
  220.   AllocMemCount: Integer; { Number of allocated memory blocks }
  221.   AllocMemSize: Integer;  { Total size of allocated memory blocks }
  222.  
  223. { Memory manager support }
  224.  
  225. procedure GetMemoryManager(var MemMgr: TMemoryManager);
  226. procedure SetMemoryManager(const MemMgr: TMemoryManager);
  227.  
  228. function SysGetMem(Size: Integer): Pointer;
  229. function SysFreeMem(P: Pointer): Integer;
  230. function SysReallocMem(P: Pointer; Size: Integer): Pointer;
  231.  
  232. function GetHeapStatus: THeapStatus;
  233.  
  234. { Thread support }
  235. type
  236.   TThreadFunc = function(Parameter: Pointer): Integer;
  237.  
  238. function BeginThread(SecurityAttributes: Pointer; StackSize: Integer;
  239.                      ThreadFunc: TThreadFunc; Parameter: Pointer;
  240.                      CreationFlags: Integer; var ThreadId: Integer): Integer;
  241.  
  242. procedure EndThread(ExitCode: Integer);
  243.  
  244. { Standard procedures and functions }
  245.  
  246. procedure _ChDir(const S: string);
  247. procedure __Flush(var F: Text);
  248. procedure _LGetDir(D: Byte; var S: string);
  249. procedure _SGetDir(D: Byte; var S: ShortString);
  250. function IOResult: Integer;
  251. procedure _MkDir(const S: string);
  252. procedure Move(const Source; var Dest; Count: Integer);
  253. function ParamCount: Integer;
  254. function ParamStr(Index: Integer): string;
  255. procedure Randomize;
  256. procedure _RmDir(const S: string);
  257. function UpCase(Ch: Char): Char;
  258.  
  259. { Wide character support procedures and functions }
  260.  
  261. function WideCharToString(Source: PWideChar): string;
  262. function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string;
  263. procedure WideCharToStrVar(Source: PWideChar; var Dest: string);
  264. procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer;
  265.   var Dest: string);
  266. function StringToWideChar(const Source: string; Dest: PWideChar;
  267.   DestSize: Integer): PWideChar;
  268.  
  269. { OLE string support procedures and functions }
  270.  
  271. function OleStrToString(Source: PWideChar): string;
  272. procedure OleStrToStrVar(Source: PWideChar; var Dest: string);
  273. function StringToOleStr(const Source: string): PWideChar;
  274.  
  275. { Variant support procedures and functions }
  276.  
  277. procedure VarClear(var V: Variant);
  278. procedure VarCopy(var Dest: Variant; const Source: Variant);
  279. procedure VarCopyNoInd(var Dest: Variant; const Source: Variant);
  280. procedure VarCast(var Dest: Variant; const Source: Variant; VarType: Integer);
  281. function VarType(const V: Variant): Integer;
  282. function VarAsType(const V: Variant; VarType: Integer): Variant;
  283. function VarIsEmpty(const V: Variant): Boolean;
  284. function VarIsNull(const V: Variant): Boolean;
  285. function VarToStr(const V: Variant): string;
  286. function VarFromDateTime(DateTime: TDateTime): Variant;
  287. function VarToDateTime(const V: Variant): TDateTime;
  288.  
  289. { Variant array support procedures and functions }
  290.  
  291. function VarArrayCreate(const Bounds: array of Integer;
  292.   VarType: Integer): Variant;
  293. function VarArrayOf(const Values: array of Variant): Variant;
  294. procedure VarArrayRedim(var A: Variant; HighBound: Integer);
  295. function VarArrayDimCount(const A: Variant): Integer;
  296. function VarArrayLowBound(const A: Variant; Dim: Integer): Integer;
  297. function VarArrayHighBound(const A: Variant; Dim: Integer): Integer;
  298. function VarArrayLock(const A: Variant): Pointer;
  299. procedure VarArrayUnlock(const A: Variant);
  300. function VarArrayRef(const A: Variant): Variant;
  301. function VarIsArray(const A: Variant): Boolean;
  302.  
  303. { Variant IDispatch call support }
  304.  
  305. procedure _DispInvokeError;
  306.  
  307. const
  308.   VarDispProc: Pointer = @_DispInvokeError;
  309.  
  310. { Procedures and functions that need compiler magic }
  311.  
  312. procedure _COS;
  313. procedure _EXP;
  314. procedure _INT;
  315. procedure _SIN;
  316. procedure _FRAC;
  317. procedure _ROUND;
  318. procedure _TRUNC;
  319.  
  320. procedure _AbstractError;
  321. procedure _Append;
  322. procedure _Assign(var T: Text; S: ShortString);
  323. procedure _BlockRead;
  324. procedure _BlockWrite;
  325. procedure _Close;
  326. procedure _PStrCat;
  327. procedure _PStrNCat;
  328. procedure _PStrCpy;
  329. procedure _PStrNCpy;
  330. procedure _EofFile;
  331. procedure _EofText;
  332. procedure _Eoln;
  333. procedure _Erase;
  334. procedure _FilePos;
  335. procedure _FileSize;
  336. procedure _FillChar;
  337. procedure _FreeMem;
  338. procedure _GetMem;
  339. procedure _ReallocMem;
  340. procedure _Halt;
  341. procedure _Halt0;
  342. procedure _Mark;
  343. procedure _PStrCmp;
  344. procedure _AStrCmp;
  345. procedure _RandInt;
  346. procedure _RandExt;
  347. procedure _ReadRec;
  348. procedure _ReadChar;
  349. procedure _ReadLong;
  350. procedure _ReadString;
  351. procedure _ReadCString;
  352. procedure _ReadLString;
  353. procedure _ReadExt;
  354. procedure _ReadLn;
  355. procedure _Rename;
  356. procedure _Release;
  357. procedure _ResetText(var T: Text);
  358. procedure _ResetFile;
  359. procedure _RewritText(var T: Text);
  360. procedure _RewritFile;
  361. procedure _RunError;
  362. procedure _Run0Error;
  363. procedure _Seek;
  364. procedure _SeekEof;
  365. procedure _SeekEoln;
  366. procedure _SetTextBuf;
  367. procedure _StrLong;
  368. procedure _Str0Long;
  369. procedure _Truncate;
  370. procedure _ValLong;
  371. procedure _WriteRec;
  372. procedure _WriteChar;
  373. procedure _Write0Char;
  374. procedure _WriteBool;
  375. procedure _Write0Bool;
  376. procedure _WriteLong;
  377. procedure _Write0Long;
  378. procedure _WriteString;
  379. procedure _Write0String;
  380. procedure _WriteCString;
  381. procedure _Write0CString;
  382. procedure _WriteLString;
  383. procedure _Write0LString;
  384. function _WriteVariant(var T: Text; const V: Variant; Width: Integer): Pointer;
  385. function _Write0Variant(var T: Text; const V: Variant): Pointer;
  386. procedure _Write2Ext;
  387. procedure _Write1Ext;
  388. procedure _Write0Ext;
  389. procedure _WriteLn;
  390.  
  391. procedure __CToPasStr;
  392. procedure __CLenToPasStr;
  393. procedure __PasToCStr;
  394.  
  395. procedure __IOTest;
  396. procedure _Flush(var F: Text);
  397.  
  398. procedure _SetElem;
  399. procedure _SetRange;
  400. procedure _SetEq;
  401. procedure _SetLe;
  402. procedure _SetIntersect;
  403. procedure _SetUnion;
  404. procedure _SetSub;
  405. procedure _SetExpand;
  406.  
  407. procedure _Str2Ext;
  408. procedure _Str0Ext;
  409. procedure _Str1Ext;
  410. procedure _ValExt;
  411. procedure _Pow10;
  412. procedure _Real2Ext;
  413. procedure _Ext2Real;
  414.  
  415. procedure _ObjSetup;
  416. procedure _ObjCopy;
  417. procedure _Fail;
  418. procedure _BoundErr;
  419. procedure _IntOver;
  420. procedure _InitExe;
  421. procedure _InitDll;
  422.  
  423. procedure _ClassCreate;
  424. procedure _ClassDestroy;
  425. procedure _AfterConstruction;
  426. procedure _BeforeDestruction;
  427. procedure _IsClass;
  428. procedure _AsClass;
  429.  
  430. procedure _RaiseExcept;
  431. procedure _RaiseAgain;
  432. procedure _DoneExcept;
  433. procedure _TryFinallyExit;
  434.  
  435. procedure _CallDynaInst;
  436. procedure _CallDynaClass;
  437. procedure _FindDynaInst;
  438. procedure _FindDynaClass;
  439.  
  440. procedure _LStrClr{var str: AnsiString};
  441. procedure _LStrArrayClr{var str: AnsiString; cnt: longint};
  442. procedure _LStrAsg{var dest: AnsiString; source: AnsiString};
  443. procedure _LStrLAsg{var dest: AnsiString; source: AnsiString};
  444. procedure _LStrFromLenStr{var dest: AnsiString; source: Pointer; length: Longint};
  445. procedure _LStrFromChar{var dest: AnsiString; source: char};
  446. procedure _LStrFromString{var dest: AnsiString; source: ShortString};
  447. procedure _LStrFromPChar{var dest: AnsiString; source: PChar};
  448. procedure _LStrFromArray{{var dest: AnsiString; source: Pointer; length: Longint};
  449. procedure _LStrToString{ var result: ShortString; s: AnsiString; resultLen: Integer};
  450. function _LStrLen{str: AnsiString}: Longint;
  451. procedure _LStrCat{var dest: AnsiString; source: AnsiString};
  452. procedure _LStrCat3{var dest:AnsiString; source1: AnsiString; source2: AnsiString};
  453. procedure _LStrCatN{var dest:AnsiString; argCnt: Integer; ...};
  454. procedure _LStrCmp{left: AnsiString; right: AnsiString};
  455. procedure _LStrAddRef{str: AnsiString};
  456. procedure _LStrToPChar{str: AnsiString): PChar};
  457. procedure _Copy{ s : ShortString; index, count : Integer ) : ShortString};
  458. procedure _Delete{ var s : openstring; index, count : Integer };
  459. procedure _Insert{ source : ShortString; var s : openstring; index : Integer };
  460. procedure _Pos{ substr : ShortString; s : ShortString ) : Integer};
  461. procedure _SetLength{var s: ShortString; newLength: Integer};
  462. procedure _SetString{var s: ShortString: buffer: PChar; len: Integer};
  463.  
  464. procedure UniqueString(var str: string);
  465. procedure _NewAnsiString{length: Longint};      { for debugger purposes only }
  466.  
  467. procedure _LStrCopy  { const s : AnsiString; index, count : Integer) : AnsiString};
  468. procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
  469. procedure _LStrInsert{ const source : AnsiString; var s : AnsiString; index : Integer };
  470. procedure _LStrPos{ const substr : AnsiString; const s : AnsiString ) : Integer};
  471. procedure _LStrSetLength{ var str: AnsiString; newLength: Integer};
  472. procedure _LStrOfChar{ c: Char; count: Integer): AnsiString };
  473. procedure _Initialize;
  474. procedure _InitializeArray;
  475. procedure _InitializeRecord;
  476. procedure _Finalize;
  477. procedure _FinalizeArray;
  478. procedure _FinalizeRecord;
  479. procedure _AddRef;
  480. procedure _AddRefArray;
  481. procedure _AddRefRecord;
  482.  
  483. procedure _New;
  484. procedure _Dispose;
  485.  
  486. procedure _DispInvoke; cdecl;
  487.  
  488. procedure _VarToInt;
  489. procedure _VarToBool;
  490. procedure _VarToReal;
  491. procedure _VarToCurr;
  492. procedure _VarToPStr(var S; const V: Variant);
  493. procedure _VarToLStr(var S: string; const V: Variant);
  494.  
  495. procedure _VarFromInt;
  496. procedure _VarFromBool;
  497. procedure _VarFromReal;
  498. procedure _VarFromTDateTime;
  499. procedure _VarFromCurr;
  500. procedure _VarFromPStr(var V: Variant; const Value: ShortString);
  501. procedure _VarFromLStr(var V: Variant; const Value: string);
  502.  
  503. procedure _VarAdd;
  504. procedure _VarSub;
  505. procedure _VarMul;
  506. procedure _VarDiv;
  507. procedure _VarMod;
  508. procedure _VarAnd;
  509. procedure _VarOr;
  510. procedure _VarXor;
  511. procedure _VarShl;
  512. procedure _VarShr;
  513. procedure _VarRDiv;
  514. procedure _VarCmp;
  515.  
  516. procedure _VarNeg;
  517. procedure _VarNot;
  518.  
  519. procedure _VarCopy;
  520. procedure _VarCopyNoInd;
  521. procedure _VarClr;
  522. procedure _VarAddRef;
  523.  
  524. function _VarArrayGet(var A: Variant; IndexCount: Integer;
  525.   Indices: Integer): Variant; cdecl;
  526. procedure _VarArrayPut(var A: Variant; const Value: Variant;
  527.   IndexCount: Integer; Indices: Integer); cdecl;
  528.  
  529. procedure _HandleAnyException;
  530. procedure _HandleOnException;
  531. procedure _HandleFinally;
  532.  
  533. procedure _AddExitProc(PP: Pointer);
  534.  
  535. procedure _FSafeDivide;
  536. procedure _FSafeDivideR;
  537.  
  538. procedure _SafeCall;
  539.  
  540. procedure FPower10;
  541. procedure _GetTls;
  542.  
  543. procedure TextStart;
  544.  
  545. { Invoked by C++ startup code to allow initialization of VCL global vars }
  546.  
  547. procedure VclInit(isDLL: Boolean; hInst: LongInt; isGui: Boolean); cdecl;
  548. procedure VclExit; cdecl;
  549.  
  550. function  CompToDouble(acomp: Comp): Double; cdecl;
  551. procedure DoubleToComp(adouble: Double; var result: Comp); cdecl;
  552. function  CompToCurrency(acomp: Comp): Currency; cdecl;
  553. procedure CurrencyToComp(acurrency: Currency; var result: Comp); cdecl;
  554.  
  555. procedure ProcessAttachTLS; cdecl;
  556. procedure ProcessDetachTLS; cdecl;
  557. procedure ThreadAttachTLS;  cdecl;
  558. procedure ThreadDetachTLS;  cdecl;
  559.  
  560. function GetMemory(Size: Integer): Pointer; cdecl;
  561. function FreeMemory(P: Pointer): Integer; cdecl;
  562. function ReallocMemory(P: Pointer; Size: Integer): Pointer; cdecl;
  563.  
  564. (* =================================================================== *)
  565.  
  566. implementation
  567.